﻿#VisualFreeBasic_Form#  Version=5.2.10
Locked=0

[Form]
Name=Form1
ClassStyle=CS_VREDRAW,CS_HREDRAW,CS_DBLCLKS
ClassName=yfPrintForm
WinStyle=WS_VISIBLE,WS_EX_LAYERED,WS_EX_LEFT,WS_EX_LTRREADING,WS_EX_RIGHTSCROLLBAR,WS_EX_TOPMOST,WS_BORDER,WS_CAPTION,WS_SYSMENU,WS_EX_TOOLWINDOW,WS_CLIPSIBLINGS,WS_CLIPCHILDREN,WS_POPUP,WS_SIZEBOX
Style=4 - 工具窗口
Icon=ico.ico|ICON_ICO
Caption=调试输出窗口
StartPosition=0 - 手动
WindowState=0 - 正常
Enabled=True
Repeat=False
Left=0
Top=0
Width=308
Height=163
TopMost=True
Child=False
MdiChild=False
TitleBar=True
SizeBox=True
SysMenu=True
MaximizeBox=False
MinimizeBox=False
Help=False
Hscroll=False
Vscroll=False
MinWidth=0
MinHeight=0
MaxWidth=0
MaxHeight=0
NoActivate=False
MousePass=False
TransPer=0
TransColor=SYS,25
BackColor=SYS,15
MousePointer=0 - 默认
Tag=
Tab=False
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[ListBox]
Name=List1
Index=-1
Style=0 - 单选
BStyle=3 - 凹边框
OwnDraw=1 - 固定行高自绘
ItemHeight=15
HasString=False
Sorted=False
NoHeight=True
MultiColumn=False
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,5
Font=微软雅黑,9
Left=13
Top=17
Width=172
Height=73
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False


[AllCode]
Dim Shared Debug_output_window_data(999) As CWSTR, Debug_output_window_i As Long 
Sub Form1_WM_Create(hWndForm As hWnd,UserData As Integer)  '完成创建窗口及所有的控件后，此时窗口还未显示。注：自定义消息里 WM_Create 此时还未创建控件和初始赋值。
   Me.Move 0, GetSystemMetrics(SM_CYFULLSCREEN) - AfxScaleY(150)
   Debug_output_window_i =-1
End Sub

Sub Form1_WM_Size(hWndForm As hWnd, fwSizeType As Long, nWidth As Long, nHeight As Long)  '窗口已经改变了大小
   'fwSizeType = SIZE_MAXHIDE     SIZE_MAXIMIZED   SIZE_MAXSHOW    SIZE_MINIMIZED    SIZE_RESTORED  
   ''            其他窗口最大化   窗口已最大化     其他窗口恢复    窗口已最小化      窗口已调整大小
   if fwSizeType = SIZE_MINIMIZED Then Return 
   'xxx.Move AfxScaleX(5), AfxScaleY(5), nWidth - AfxScaleX(10), nHeight - AfxScaleY(30)
   List1.Move 0, 0, nWidth, nHeight 
      
End Sub

Function Form1_List1_OwnerDraw(hWndForm As hWnd, hWndControl As hWnd, lpdis As DRAWITEMSTRUCT) As LResult  '自绘控件（需要设计时选择自绘属性）
   'lpdis.hDC         设备上下文的句柄
   'lpdis.rcItem      一个矩形，要绘制的控件的边界。
   'lpdis.itemAction  绘图操作: ODA_DRAWENTIRE 需要绘制整个控件, ODA_FOCUS 失去或获得焦点, ODA_SELECT 选择状态已更改
   ''                 例： if (lpdis.itemAction And ODA_DRAWENTIRE)<>0  Then
   'lpdis.itemState   视觉状态  详细说明，选中它 DRAWITEMSTRUCT 然后按 F1 键盘
   If lpdis.itemID = &HFFFFFFFF Then Return 0 '如果列表为空 =-1
   Dim i As Long = lpdis.itemID
   if Debug_output_window_i > 999 Then  '最多保存 1000 个，超过用循环记录
      Dim ii As Long = (Debug_output_window_i Mod 1000) + 1 '算出 0 位置 ，因为 Debug_output_window_i 是最后位置
      i += ii
      if i > 999 Then i -= 1000
   End if
   SetBkMode lpdis.hDC, 1  '设置这个后，画上的字是透明的
   Dim tFont as HFONT
   Dim oFont as HGDIOBJ
   tFont = AfxCreateFont("SimSun", 9, -1)
   oFont = SelectObject(lpdis.hDC, tFont)
   Select Case lpdis.itemAction
      Case ODA_DRAWENTIRE, ODA_SELECT '要绘画消息
         If (lpdis.itemState And ODS_SELECTED) = 0 Then                  ' 未选中
            FillRect lpdis.hDC, @lpdis.rcItem, GetSysColorBrush(COLOR_WINDOW)     ' 画背景，填充底色
            SetTextColor lpdis.hDC, GetSysColor(COLOR_WINDOWTEXT)       ' 文本颜色
         Else                                                             ' 处于选中状态
            FillRect lpdis.hDC, @lpdis.rcItem, GetSysColorBrush(COLOR_HIGHLIGHT)  ' 画背景，填充底色
            SetTextColor lpdis.hDC, GetSysColor(COLOR_HIGHLIGHTTEXT)    ' 文本颜色
         End If
         lpdis.rcItem.Left += AfxScaleX(3)  '让文本偏一点，不然太靠左边了
         DrawTextW lpdis.hDC, Debug_output_window_data(i), -1, @lpdis.rcItem, DT_SINGLELINE Or DT_LEFT Or DT_VCENTER
         Return True '告诉系统，表示自己画了，不需要系统处理
   End Select
   DeleteObject tFont
   DeleteObject oFont
   Function = FALSE ' 如果处理了此事件，则应返回 TRUE 。
End Function

Sub Form1_List1_WM_ContextMenu(hWndForm As hWnd, hWndControl As hWnd, xPos As Long, yPos As Long)  '鼠标右键单击
   Dim yMenu As HMENU = CreatePopupMenu
   Dim i As Long = List1.ListIndex , bb As CWSTR, cc() As CWSTR
   if i > -1 Then
      if Debug_output_window_i > 999 Then  '最多保存 1000 个，超过用循环记录
         Dim ii As Long = (Debug_output_window_i Mod 1000) + 1 '算出 0 位置 ，因为 Debug_output_window_i 是最后位置
         i += ii
         if i > 999 Then i -= 1000
      End if
      bb = Debug_output_window_data(i)
   End if
   Dim tFont As HFONT
   If IsVista Then
      If AfxScaleX(1) = 1 Then
         tFont = AfxCreateFont("Microsoft YaHei", 12, -1)
      Else
         tFont = AfxCreateFont("Microsoft YaHei", 11, -1)
      End If
   Else
      tFont = AfxCreateFont("SimSun", 10, -1)
   End If
   if Len(bb) Then
      AddMenuText(yMenu, 99, "复制选择行", tFont, 36873, &H000000)
      AppendMenuA yMenu, MF_SEPARATOR, 0, ""   '1[22:11:23.02] API: | 720D26E0 | 7
      vbSplitW bb, !"\u0020\u007C\u0020", CC()
      ReDim Preserve cc(UBound(cc) + 1)
      For i = UBound(cc) To 1 Step -1
         cc(i) = cc(i -1)
      Next
      i = InStr( * *cc(0), !"\u0020")
      if i > 0 Then
         cc(0) = left( * *cc(0), i -1)
         cc(1) = mid( * *cc(1), i + 1)
      End if
      AddMenuText(yMenu, 100, "复制时间", tFont, 26102, &H000000)
      For i = 1 To UBound(cc)
         AddMenuText(yMenu, 100 + i, "复制第 " & i & " 个", tFont, 48 + i, &H000000)
      Next
      AppendMenuA yMenu, MF_SEPARATOR, 0, ""
      'AppendMenuA yMenu, MF_STRING, 98, "复制全部"
      AddMenuText(yMenu, 98, "复制全部", tFont, 20840, &H000000)
      AppendMenuA yMenu, MF_SEPARATOR, 0, ""
   End if
   'AppendMenuA yMenu, MF_STRING, 1, "清空列表"
   AddMenuText(yMenu, 1, "清空列表", tFont, 31354, &H000000)
   DeleteObject tFont
   Dim P as Point
   GetCursorPos @p
   dim id As Long = TrackPopupMenu(yMenu, TPM_RETURNCMD Or TPM_NONOTIFY, p.x, p.y, 0, hWndForm, Null) '比方说弹出菜单
   select case id
      Case 0
      Case 1
         List1.Clear 
         Debug_output_window_i = -1
      Case 98
         ReDim cc(999)
         Dim ii As Long
         For i = 0 To 999
            if Debug_output_window_i > 999 Then
               ii = (Debug_output_window_i Mod 1000) + 1
               ii += i
               if ii > 999 Then ii -= 1000
            Else
               ii = i
            End if
            if Len(Debug_output_window_data(ii)) = 0 Then
               ReDim Preserve cc(i -1)
               Exit For
            End if
            cc(i) = Debug_output_window_data(ii)
         Next
         bb = FF_JoinW(cc(), WChr(13, 10))
         AfxSetClipboardText bb
      case 99
         AfxSetClipboardText bb
      case Else
         AfxSetClipboardText cc(id -100)
   End Select
   DestroyMenu yMenu
End Sub

Function Form1_Custom(hWndForm As hWnd, wMsg As UInteger, wParam As wParam, lParam As lParam) As LResult  '自定义消息（全部消息），在其它事件处理后才轮到本事件。
   Select Case wMsg
      Case WM_COPYDATA
         Select Case wParam
            Case &H502 ' 来自软件  调试输出
               Dim aa As COPYDATASTRUCT Ptr = Cast(Any Ptr, lParam)
               Debug_output_window_i += 1
               Dim i As Long = Debug_output_window_i Mod 1000 '最多保存 1000 个，超过用循环记录
               Debug_output_window_data(i) = WStr(Debug_output_window_i + 1) & !"\u005B" & StringToCWSTR(Format(Now, "hh:mm:ss") & Right(Format(Timer, "0.00"), 3)) & !"\u005D\u0020" & *CPtr(WString Ptr,aa->lpData)  
               if Debug_output_window_i > 999 Then
                  i = 999
               Else
                 i= List1.AddItem ("")
               End if
               List1.ListIndex = i
               List1.ReDraw 
               Return TRUE
         End Select
          
   End Select
   Function = FALSE ' 若不想系统继续处理此消息，则应返回 TRUE （俗称吃掉消息）。
End Function










